home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / totsrc.zip / TOTFAST.PAS < prev    next >
Pascal/Delphi Source File  |  1991-02-11  |  57KB  |  2,116 lines
  1. {               Copyright 1991 TechnoJock Software, Inc.               }
  2. {                          All Rights Reserved                         }
  3. {                         Restricted by License                        }
  4.  
  5. {                             Build # 1.00                             }
  6.  
  7. Unit totFAST;
  8. {$I TOTFLAGS.INC}
  9.  
  10. {
  11.  Development Notes:
  12.  6) Add save of display attr (TextColor and TextBackground)
  13.  7) Add save of display mode
  14. }
  15.  
  16. INTERFACE
  17.  
  18. uses DOS, CRT, totSYS, totLOOK, totINPUT;
  19.  
  20. TYPE
  21.  
  22. StrScreen = string[255];   {alter as necessary}
  23. StrVisible = string[80];   {alter as necessary}
  24. tDirection = (Up, Down, Left, Right, Vert, Horiz);
  25. tCoords = record
  26.    X1,Y1,X2,Y2:shortint;
  27. end;
  28. tByteCoords = record
  29.    X1,Y1,X2,Y2:byte;
  30. end;
  31. ShadowPosition = (UpLeft,UpRight,DownLeft,DownRight);
  32.  
  33. WritePtr = ^WriteOBJ;
  34. pWriteOBJ = ^WriteOBJ;
  35. WriteOBJ = object
  36.    vWidth: byte;           {how wide is screen}
  37.    vScreenPtr: pointer;    {memory location of screen data}
  38.    vWindow: tByteCoords;   {active screen area}
  39.    vWindowOn: boolean;     {is window area active}
  40.    vWindowIgnore: boolean; {ignore window settings}
  41.    {methods...}
  42.    constructor Init;
  43.    procedure   SetScreen(var P:Pointer; W:byte);
  44.    function    WindowOff: boolean;
  45.    procedure   SetWinIgnore(On:Boolean);
  46.    procedure   WindowOn;
  47.    procedure   WindowCoords(var Coords: tByteCoords);
  48.    function    WindowActive: boolean;
  49.    function    WinX: byte;
  50.    function    WinY: byte;
  51.    procedure   GetWinCoords(var X1,Y1,X2,Y2:byte);
  52.    procedure   WriteAT(X,Y,attr:byte;Str:string);                     VIRTUAL;
  53.    procedure   WritePlain(X,Y:byte;Str:string);                       VIRTUAL;
  54.    procedure   Write(Str:string);                                     VIRTUAL;
  55.    procedure   WriteLn(Str:string);                                   VIRTUAL;
  56.    procedure   GotoXY(X,Y: word);                                     VIRTUAL;
  57.    function    WhereX: word;                                          VIRTUAL;
  58.    function    WhereY: word;                                          VIRTUAL;
  59.    procedure   SetWindow(X1,Y1,X2,Y2: byte);                          VIRTUAL;
  60.    procedure   ResetWindow;                                           VIRTUAL;
  61.    procedure   ChangeAttr(X,Y,Att:byte;Len:word);                     VIRTUAL;
  62.    procedure   MoveFromScreen(var Source,Dest;Len:Word);              VIRTUAL;
  63.    procedure   MoveToScreen(var Source,Dest; Len:Word);               VIRTUAL;
  64.    procedure   Clear(Att:byte;Ch:char);                               VIRTUAL;
  65.    destructor  Done;                                                  VIRTUAL;
  66. end; {WriteOBJ}
  67.  
  68. ScreenPtr = ^ScreenOBJ;
  69. pScreenOBJ = ^ScreenOBJ;
  70. ScreenOBJ = object
  71.    vWidth: byte;           {how wide is screen}
  72.    vDepth: byte;           {how many lines}
  73.    vScreenPtr: pointer;    {memory location of screen data}
  74.    vCursX: byte;           {cursor location}
  75.    vCursY: byte;           {      -"-      }
  76.    vCursTop: byte;         {cursor size}
  77.    vCursBot: byte;         {    -"-    }
  78.    oWritePtr: WritePtr;    {screen writing and moving object}
  79.    vHiMarker: char;        {character to indicate attribute change}
  80.    vVisible: boolean;      {is the screen mapped to visible display}
  81.    vOnScreen:boolean;
  82.    {methods...}
  83.    constructor Init;
  84.    procedure   DesqViewTest;
  85.    procedure   SetHiMarker(M:char);
  86.    function    HiMarker:char;
  87.    procedure   AssignWriteOBJ(var Wri: WriteOBJ);
  88.    procedure   SetWindow(X1,Y1,X2,Y2: byte);
  89.    procedure   SetWinIgnore(On:Boolean);
  90.    procedure   ResetWindow;
  91.    function    WindowOff:boolean;
  92.    procedure   WindowOn;
  93.    procedure   WindowCoords(var Coords: tByteCoords);
  94.    function    WindowActive: boolean;
  95.    function    OnScreen:boolean;
  96.    function    CharHeight: integer;
  97.    procedure   CursReset;
  98.    procedure   CursSave; 
  99.    procedure   GotoXY(X,Y: word); 
  100.    procedure   CursSize(T,B: byte);
  101.    function    WhereX: word; 
  102.    function    WhereY: word;
  103.    function    CursTop: byte; 
  104.    function    CursBot: byte; 
  105.    procedure   CursHalf;
  106.    procedure   CursFull;
  107.    procedure   CursOn;
  108.    procedure   CursOff;
  109.    procedure   Exists; 
  110.    procedure   MoveToScreen(var Source, Dest; Length:word); 
  111.    procedure   MoveFromScreen(var Source, Dest; Length:word); 
  112.    procedure   Save;
  113.    procedure   Create(X,Y,Attr:byte);
  114.    function    Width: byte; 
  115.    function    Depth: byte;
  116.    function    ScreenPtr: pointer; 
  117.    procedure   Display;
  118.    procedure   PartDisplay(X1,Y1,X2,Y2,X,Y:byte);
  119.    procedure   PartSlideDisplay(X1,Y1,X2,Y2:byte;Way:tDirection);
  120.    procedure   SlideDisplay(Way: tDirection);
  121.    procedure   PartSave (X1,Y1,X2,Y2:byte; VAR Dest);
  122.    procedure   PartRestore (X1,Y1,X2,Y2:byte; VAR Source);
  123.    procedure   CopyScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  124.    procedure   MoveScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  125.    procedure   Scroll(Way:tDirection;X1,Y1,X2,Y2:byte);
  126.    procedure   Write(Str:string);
  127.    procedure   WriteLn(Str:string);
  128.    procedure   WriteAT(X,Y,attr:byte;Str:string); 
  129.    procedure   WriteHi(X,Y,AttrHi,Attr:byte;Str:string);
  130.    procedure   WritePlain(X,Y:byte;Str:string); 
  131.    procedure   WriteCap(X,Y,AttrCap,Attr:byte;Str:string);
  132.    procedure   WriteClick(X,Y,attr:byte;Str:string);
  133.    procedure   WriteCenter(Y,Attr:byte;Str:string);
  134.    procedure   WriteBetween(X1,X2,Y,Attr:byte;Str:string);
  135.    procedure   WriteRight(X,Y,Attr:byte;Str:string);
  136.    procedure   WriteVert(X,Y,Attr:byte;Str:string);
  137.    procedure   Attrib(X1,Y1,X2,Y2,Attr:byte); 
  138.    procedure   Clear(Att:byte;Ch:char);
  139.    procedure   PartClear(X1,Y1,X2,Y2,Att:byte;Ch:char);
  140.    procedure   ClearText(X1,Y1,X2,Y2:byte);
  141.    procedure   ReadWord(X,Y:byte;var Attr:byte; var Ch : char); 
  142.    function    ReadChar(X,Y:byte):char;
  143.    function    ReadAttr(X,Y:byte):byte;
  144.    function    ReadStr(X1,X2,Y:byte):string;
  145.    procedure   BoxEngine(X1,Y1,X2,Y2,LeftPad,RightPad,Battr,Tattr,Mattr,style:byte;
  146.                          Filled:boolean;
  147.                          Title:string); 
  148.    procedure   TitleEngine(X1,Y1,X2,Y2,LeftPad,RightPad,Battr,Tattr:byte;Str,Title:string);
  149.    procedure   Box(X1,Y1,X2,Y2,attr,style:byte);
  150.    procedure   FillBox(X1,Y1,X2,Y2,attr,style:byte);
  151.    procedure   ShadFillBox(X1,Y1,X2,Y2,attr,style:byte);
  152.    procedure   TitledBox(X1,Y1,X2,Y2,Battr,Tattr,Mattr,style:byte;Title:string);
  153.    procedure   HorizLine(X1,X2,Y,Attr,Style : byte);
  154.    procedure   VertLine(X,Y1,Y2,Attr,Style:byte);
  155.    procedure   SmartVertLine(X,Y1,Y2,Attr,Style:byte);
  156.    procedure   SmartHorizLine(X1,X2,Y,Attr,Style:byte);
  157.    procedure   WriteHScrollBar(X1,X2,Y,Attr: byte; Current,Max: longint);
  158.    procedure   WriteVScrollBar(X,Y1,Y2,Attr: byte; Current,Max: longint);
  159.    destructor  Done;
  160. end; {ScreenOBJ}
  161.  
  162. pScrollOBJ = ^ScrollOBJ;
  163. ScrollOBJ = object
  164.    vUpArrowChar: char;
  165.    vDownArrowChar: char;
  166.    vLeftArrowChar: char;
  167.    vRightArrowChar: char;
  168.    vElevatorChar: char;
  169.    vBackgroundChar: char;
  170.    {methods...}
  171.    constructor Init;
  172.    procedure   SetDefaults;
  173.    procedure   SetScrollChars(U,D,L,R,E,B:char);
  174.    function    UpChar: char;
  175.    function    DownChar: char;
  176.    function    LeftChar: char;
  177.    function    RightChar: char;
  178.    function    ElevatorChar: char;
  179.    function    BackgroundChar: char;
  180.    destructor  Done;
  181. end; {ScrollOBJ}
  182.  
  183. pShadowOBJ = ^ShadowOBJ;
  184. ShadowOBJ = object
  185.    vShadPos: ShadowPosition;   {where is shadow}
  186.    vShadAttr: byte;            {shadow attribute}
  187.    vShadChar: char;            {shadow character - ' ' is see-through}
  188.    vShadWidth: byte;           {shadow width in characters}
  189.    vShadDepth: byte;           {shadow depth in characters}
  190.    {methods...}
  191.    constructor Init;
  192.    procedure   SetDefaults;
  193.    procedure   SetShadowStyle(ShadP:ShadowPosition; ShadA:byte; ShadC: char);
  194.    procedure   SetShadowSize(ShadW,ShadD:byte);
  195.    function    ShadWidth: byte;
  196.    function    ShadDepth: byte;
  197.    function    ShadAttr: byte;
  198.    function    ShadChar: char;
  199.    function    ShadPos: ShadowPosition;
  200.    procedure   DrawShadow(Border:tCoords);
  201.    procedure   DrawShadowXY(X1,Y1,X2,Y2:integer);
  202.    procedure   OuterCoords(Border:tCoords;var Outer:tCoords);
  203.    procedure   OuterXY(var X1,Y1,X2,Y2: integer);
  204.    destructor  Done;
  205. end; {ShadowOBJ}
  206.  
  207. VAR
  208.   Screen: ScreenOBJ;
  209.   ScrollTOT: ^ScrollOBJ;
  210.   ShadowTOT: ^ShadowOBJ;
  211.   SnowProne : byte;
  212.  
  213. function  CAttr(F,B:byte):byte;
  214. function  FAttr(A:byte): byte;
  215. function  BAttr(A:byte): byte;
  216. function  Replicate(N : byte; Character:char): string;
  217. procedure fastINIT;
  218.  
  219. IMPLEMENTATION
  220. Const
  221.     TitPos:string[6] = '<+>^|_';  {characters signifying box title position}
  222.     WinCursX: byte = 1;
  223.     WinCursY: byte = 1;
  224. {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  225. {                                                               }
  226. {     U N I T   P R O C E D U R E S   &   F U N C T I O N S     }
  227. {                                                               }
  228. {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  229.  
  230. procedure Error(Err:byte);
  231. {temp routine to display error - replace with object}
  232. const
  233.    Header = 'totFAST error: ';
  234. var
  235.    Msg : string;
  236. begin
  237.    Case Err of
  238.    1: Msg := 'Not enough memory to initialize screen';
  239.    2: Msg := 'Cannot write to inactive screen';
  240.    3: Msg := 'Not enough memory for screen move/copy';
  241.    else  Msg := 'Unknown Error';
  242.    end; {case}
  243.    Writeln(Header,Msg);
  244.    halt;
  245. end; {Error}
  246.  
  247. function CAttr(F,B:byte):byte;
  248. {converts foreground(F) and background(B) colors to combined Attribute byte}
  249. begin
  250.    CAttr := (B Shl 4) or F;
  251. end;  {CAttr}
  252.  
  253. function FAttr(A:byte): byte;
  254. {returns the foreground color from an attribute Byte}
  255. begin
  256.    FAttr := A and 15;
  257. end; {FAttr}
  258.  
  259. function BAttr(A:byte): byte;
  260. {returns the background color from an attribute Byte}
  261. begin
  262.    BAttr := (A and 112) shr 4;
  263. end; {FAttr}
  264.  
  265. function Replicate(N : byte; Character:char): string;
  266. {returns a string with Character repeated N times}
  267. var tempstr: string;
  268. begin
  269.     If N = 0 then
  270.        TempStr := ''
  271.     else
  272.     begin
  273.        Fillchar(tempstr,N+1,Character);
  274.        Tempstr[0] := chr(N);
  275.     end;
  276.     Replicate := Tempstr;
  277. end; {replicate}
  278.  
  279. {$L totFAST}
  280. {$F+}
  281.   procedure AsmWrite(var scrptr; Wid,Col,Row,Attr:byte; St:String); external;
  282.   procedure AsmPWrite(var scrptr; Wid,Col,Row:byte; St:String); external;
  283.   procedure AsmAttr(var scrptr; Wid,Col,Row,Attr,Len:byte); external;
  284.   Procedure AsmMoveFromScreen(var Source,Dest;Length:Word); external;
  285.   Procedure AsmMoveToScreen(var Source,Dest; Length:Word); external;
  286. {$IFNDEF OVERLAY}
  287.    {$F-}
  288. {$ENDIF}
  289.  
  290. {|||||||||||||||||||||||||||||||||||||||||}
  291. {                                         }
  292. {     W r i t e O B J   M E T H O D S     }
  293. {                                         }
  294. {|||||||||||||||||||||||||||||||||||||||||}
  295. constructor WriteOBJ.Init;
  296. {}
  297. begin
  298.    vWindowOn := false;
  299.    vWindowIgnore := false;
  300. end; {WriteOBJ.Init}
  301.  
  302. procedure WriteOBJ.SetScreen(var P:Pointer; W:byte);
  303. {}
  304. begin
  305.    vScreenPtr := P;
  306.    vWidth := W;
  307. end; {WriteOBJ.SetScreen}
  308.  
  309. procedure WriteOBJ.SetWindow(X1,Y1,X2,Y2: byte);
  310. {}
  311. begin
  312.    CRT.Window(X1,Y1,X2,Y2);
  313.    vWindow.X1 :=  X1;
  314.    vWindow.Y1 :=  Y1;
  315.    vWindow.X2 :=  X2;
  316.    vWindow.Y2 :=  Y2;
  317.    vWindowOn := true;
  318. end; {WriteOBJ.SetWindow}
  319.  
  320. procedure WriteOBJ.GetWinCoords(var X1,Y1,X2,Y2:byte);
  321. {}
  322. begin
  323.    X1 :=  vWindow.X1;
  324.    Y1 :=  vWindow.Y1;
  325.    X2 :=  vWindow.X2;
  326.    Y2 :=  vWindow.Y2;
  327. end; {WriteOBJ.GetWinCoords}
  328.  
  329. procedure WriteOBJ.ResetWindow;
  330. {}
  331. var H,W: byte;
  332. begin
  333.    W := Monitor^.Width;
  334.    H := Monitor^.Depth;
  335.    CRT.Window(1,1,W,H);
  336.    vWindow.X1 := 1;
  337.    vWindow.Y1 := 1;
  338.    vWindow.X2 := W;
  339.    vWindow.Y2 := H;
  340.    vWindowOn := false;
  341. end; {WriteOBJ.ResetWindow}
  342.  
  343. function WriteOBJ.WindowOff:boolean;
  344. {}
  345. begin
  346.    if vWindowOn then
  347.    begin
  348.       vWindowOn := false;
  349.       WinCursX := WhereX;
  350.       WinCursY := WhereY;
  351.       CRT.window(1,1,Monitor^.Width,Monitor^.Depth);
  352.       WindowOff := true;
  353.    end
  354.    else
  355.       WindowOff := false;
  356. end; {WriteOBJ.WindowOff}
  357.  
  358. procedure WriteOBJ.WindowOn;
  359. {}
  360. begin
  361.    vWindowOn := true;
  362.    window(vWindow.X1,vWindow.Y1,vWindow.X2,vWindow.Y2);
  363.    GotoXY(WinCursX,WinCursY);
  364. end; {WriteOBJ.WindowOn}
  365.  
  366. procedure WriteOBJ.WindowCoords(var Coords: tByteCoords);
  367. {}
  368. begin
  369.    Coords := vWindow;
  370. end; {WriteOBJ.WindowCoords}
  371.  
  372. function WriteOBJ.WindowActive: boolean;
  373. {}
  374. begin
  375.    WindowActive := vWindowOn;
  376. end; {WriteOBJ.WindowActive}
  377.  
  378. procedure WriteOBJ.SetWinIgnore(On:Boolean);
  379. {}
  380. begin
  381.    vWindowIgnore := On;
  382. end; {WriteOBJ.SetWinIgnore}
  383.  
  384. function WriteOBJ.WinX: byte;
  385. {}
  386. begin
  387.    if vWindowOn and not vWindowIgnore then
  388.       WinX := vWindow.X1
  389.    else
  390.       WinX := 1;
  391. end; {WriteOBJ.WinX}
  392.  
  393. function WriteOBJ.WinY: byte;
  394. {}
  395. begin
  396.    if vWindowOn and not vWindowIgnore then
  397.       WinY := vWindow.Y1
  398.    else
  399.       WinY := 1;
  400. end; {WriteOBJ.WinY}
  401.  
  402. procedure WriteOBJ.WriteAT(X,Y,attr:byte;Str:string);
  403. {}
  404. begin
  405.    if not vWindowOn or vWindowIgnore then
  406.       ASMWrite(vScreenPtr^,vWidth,X,Y,attr,Str)
  407.    else
  408.    begin
  409.       Str := copy(Str,1,vWindow.X2 - pred(X) - pred(vWindow.X1));
  410.       if Y + pred(vWindow.Y1) <= vWindow.Y2 then
  411.          ASMWrite(vScreenPtr^,vWidth,pred(vWindow.X1)+X,
  412.                                         pred(vWindow.Y1)+Y,
  413.                                         attr,Str);
  414.    end;
  415. end; {WriteOBJ.WriteAT}
  416.  
  417. procedure WriteOBJ.WritePlain(X,Y:byte;Str:string);
  418. {}
  419. begin
  420.    if not vWindowOn or vWindowIgnore then
  421.       ASMPWrite(vScreenPtr^,vWidth,X,Y,Str)
  422.    else
  423.    begin
  424.       Str := copy(Str,1,vWindow.X2 - pred(X) - pred(vWindow.X1));
  425.       if Y + pred(vWindow.Y1) <= vWindow.Y2 then
  426.          ASMPWrite(vScreenPtr^,vWidth,pred(vWindow.X1)+X,
  427.                                         pred(vWindow.Y1)+Y,
  428.                                         Str);
  429.    end;
  430. end; {WriteOBJ.WritePlain}
  431.  
  432. procedure WriteOBJ.Write(Str:string);
  433. {}
  434. begin
  435.    System.Write(Str)
  436. end; {WriteOBJ.Write}
  437.  
  438. procedure WriteOBJ.WriteLn(Str:string);
  439. {}
  440. begin
  441.    System.WriteLn(Str);
  442. end; {WriteOBJ.WriteLn}
  443.  
  444. procedure WriteOBJ.GotoXY(X,Y: word);                                    
  445. {}
  446. begin
  447.    CRT.GotoXY(X,Y);
  448. end; {WriteOBJ.GotoXY}
  449.  
  450. function  WriteOBJ.WhereX: word;                                         
  451. {}
  452. begin
  453.    WhereX := CRT.WhereX;
  454. end; {WriteOBJ.WhereX}
  455.  
  456. function  WriteOBJ.WhereY: word;                                         
  457. {}
  458. begin
  459.    WhereY := CRT.WhereY;
  460. end; {WriteOBJ.WhereY}
  461.  
  462. procedure WriteOBJ.ChangeAttr(X,Y,Att:byte;Len:word);
  463. {}
  464. begin
  465.    if not vWindowOn or vWindowIgnore then
  466.       ASMAttr(vScreenPtr^,vWidth,X,Y,Att,Len)
  467.    else
  468.    begin
  469.       inc(X,pred(vWindow.X1));
  470.       inc(Y,pred(vWindow.Y1));
  471.       if (X <= vWindow.X2) and (Y <= vWindow.Y2) then
  472.       begin
  473.          if X + Len > vWindow.X2 then
  474.             Len := vWindow.X2 - pred(X);
  475.          ASMAttr(vScreenPtr^,vWidth,X,Y,Att,Len)
  476.       end;
  477.    end;
  478. end; {WriteOBJ.ChangeAttr}
  479.  
  480. procedure WriteOBJ.MoveFromScreen(var Source,Dest;Len:Word);
  481. {}
  482. begin
  483.    ASMMoveFromScreen(Source,Dest,Len);
  484. end; {WriteOBJ.MoveFromScreen}
  485.  
  486. procedure WriteOBJ.MoveToScreen(var Source,Dest; Len:Word);
  487. {}
  488. begin
  489.    ASMMoveToScreen(Source,Dest,Len);
  490. end; {WriteOBJ.MoveToScreen}
  491.  
  492. procedure WriteOBJ.Clear(Att:byte;Ch:char);                              
  493. {}
  494. var
  495.    I : integer;
  496.    S : string;
  497. begin
  498.    with vWindow do
  499.    begin
  500.        S := Replicate(Succ(X2-X1),Ch);
  501.        for I := 1 to succ(Y2-Y1) do
  502.        begin
  503.           ChangeAttr(X1,Y1,Att,succ(X2-X1));
  504.           WritePlain(1,I,S);
  505.        end;
  506.    end;
  507. end; {WriteOBJ.Clear}
  508.  
  509. destructor WriteOBJ.Done;
  510. {}
  511. begin 
  512. end; {WriteOBJ.Done}
  513. {|||||||||||||||||||||||||||||||||||||||||||}
  514. {                                           }
  515. {     S c r e e n O B J   M E T H O D S     }
  516. {                                           }
  517. {|||||||||||||||||||||||||||||||||||||||||||}
  518. constructor ScreenOBJ.Init;
  519. {}
  520. begin
  521.    vScreenPtr := nil;
  522.    vHiMarker := '~';
  523.    vVisible := false;
  524.    vOnScreen := false;
  525.    New(oWritePtr,Init);
  526.    oWritePtr^.SetScreen(vScreenPtr,vWidth);
  527.    ResetWindow;
  528. end; {ScreenOBJ.Init}
  529.  
  530. procedure ScreenOBJ.SetHiMarker(M:char);
  531. {}
  532. begin
  533.    vHiMarker := M;
  534. end; {ScreenOBJ.SetHiMarker}
  535.  
  536. function ScreenOBJ.HiMarker:char;
  537. {}
  538. begin
  539.    Himarker := vHiMarker;
  540. end; {ScreenOBJ.Himarker}
  541.  
  542. procedure ScreenOBJ.AssignWriteOBJ(var Wri: WriteOBJ);
  543. {}
  544. begin
  545.    Dispose(oWritePtr,Done);
  546.    oWritePtr := @Wri;
  547.    oWritePtr^.SetScreen(vScreenPtr,vWidth);
  548. end; {ScreenOBJ.AssignWriteOBJ}
  549.  
  550. procedure ScreenOBJ.SetWindow(X1,Y1,X2,Y2: byte);
  551. {}
  552. begin
  553.    oWritePtr^.SetWindow(X1,Y1,X2,Y2);
  554. end; {ScreenOBJ.SetWindow}
  555.  
  556. procedure ScreenOBJ.SetWinIgnore(On:Boolean);
  557. {}
  558. begin
  559.    oWritePtr^.SetWinIgnore(On);
  560. end; {ScreenOBJ.SetWinIgnore}
  561.  
  562. procedure ScreenOBJ.ResetWindow;
  563. {}
  564. begin
  565.    oWritePtr^.ResetWindow;
  566. end; {ScreenOBJ.ResetWindow}
  567.  
  568. function ScreenOBJ.WindowOff:boolean;
  569. {}
  570. begin
  571.    WindowOff := oWritePtr^.WindowOff;
  572. end; {ScreenOBJ.WindowOff}
  573.  
  574. procedure ScreenOBJ.WindowOn;
  575. {}
  576. begin
  577.    oWritePtr^.WindowOn;
  578. end; {ScreenOBJ.WindowOn}
  579.  
  580. procedure ScreenOBJ.WindowCoords(var Coords: tByteCoords);
  581. {}
  582. begin
  583.    oWritePtr^.WindowCoords(Coords);
  584. end; {ScreenOBJ.WindowCoords}
  585.  
  586. function ScreenOBJ.WindowActive: boolean;
  587. {}
  588. begin
  589.    WindowActive := oWritePtr^.WindowActive;
  590. end; {ScreenOBJ.WindowActive}
  591. {|||||||||||||||||||||||||||||||||}
  592. {     C U R S O R   S T U F F     }
  593. {|||||||||||||||||||||||||||||||||}
  594. function ScreenOBJ.OnScreen: boolean;
  595. {is this instance the visible screen}
  596. begin
  597.    OnScreen := vOnScreen;
  598. end; {ScreenOBJ.OnScreen}
  599.  
  600. function ScreenOBJ.CharHeight: integer;
  601. {get height of text mode characters for cursor manipulation}
  602. var
  603.    Regs: Registers;
  604. begin
  605.    if OnScreen then
  606.    begin
  607.       case Monitor^.DisplayType of
  608.       Mono: CharHeight := 14;
  609.       EGACol,
  610.       CGA : CharHeight := 8;
  611.       else
  612.          with Regs do
  613.          begin
  614.             Ah := $11;
  615.             Al := $30;
  616.             BX := $0;
  617.             Intr($10,Regs);
  618.             CharHeight := CX;
  619.          end; {with}
  620.       end;  {case}
  621.    end
  622.    else        {virtual screen assume normal mode}
  623.    begin
  624.       if Monitor^.DisplayType = Mono then
  625.          CharHeight := 14
  626.       else
  627.          CharHeight := 8;
  628.    end;
  629. end; {ScreenOBJ.CharHeight}
  630.  
  631. procedure ScreenOBJ.CursReset;
  632. {}
  633. begin
  634.    GotoXY(1,1);
  635.    CursOn;
  636. end; {ScreenOBJ.CursReset}
  637.  
  638. procedure ScreenOBJ.CursSave;
  639. {updates instance with visible Cursor details}
  640. var Reg : registers;
  641. begin
  642.    with Reg do
  643.    begin
  644.       Ax := $0F00; {get page in Bx}
  645.       intr($10,reg);
  646.       Ax := $0300;
  647.       intr($10,reg);
  648.       vCursX := lo(Dx) + 1;
  649.       vCursY := hi(Dx) + 1;
  650.       vCursTop := Hi(Cx) and $0F;
  651.       vCursBot := Lo(Cx) and $0F;
  652.    end;
  653. end; {ScreenOBJ.CursSave}
  654.  
  655. procedure ScreenOBJ.CursSize(T,B : byte);
  656. {}
  657. var Reg: registers;
  658. begin
  659.    if OnScreen then {writing to a visible screen}
  660.    begin
  661.       with reg do
  662.       begin
  663.          AX := $0100;
  664.          if (T=0) and (B=0) then
  665.             CX := $2000
  666.          else
  667.          begin
  668.          (*  
  669.          If you have an odd video bios and cursor changes
  670.          are strange, enable this next line.
  671.             mem[$40:$87] := mem[$40:$87] or $01; {get cursor ownership from BIOS}
  672.          *)
  673.             Ch := T;
  674.             Cl := B;
  675.          end;
  676.          intr($10,Reg);
  677.       end;
  678.    end;
  679.    vCursTop := T;
  680.    vCursBot := B;
  681. end; {ScreenOBJ.CursSize}
  682.  
  683. function ScreenOBJ.WhereX: word;
  684. {}
  685. begin
  686.    if OnScreen then {writing to a visible screen}
  687.       WhereX := oWritePtr^.WhereX
  688.    else
  689.       WhereX := vCursX;
  690. end; {ScreenOBJ.WhereX}
  691.  
  692. function ScreenOBJ.WhereY: word;
  693. {}
  694. begin
  695.    if OnScreen then {writing to a visible screen}
  696.       WhereY := oWritePtr^.WhereY
  697.    else
  698.       WhereY := vCursY;
  699. end; {ScreenOBJ.WhereY}
  700.  
  701. procedure ScreenOBJ.GotoXY(X,Y:word);
  702. {}
  703. begin
  704.    if OnScreen then {writing to a visible screen}
  705.       oWritePtr^.GotoXY(X,Y)
  706.    else
  707.    begin
  708.       vCursX := X;
  709.       vCursY := Y;
  710.    end;
  711. end; {ScreenOBJ.CursGotoXY}
  712.  
  713. function ScreenOBJ.CursTop: byte;
  714. {}
  715. begin
  716.    CursTop := vCursTop;
  717. end; {ScreenOBJ.CursTOP}
  718.  
  719. function ScreenOBJ.CursBot: byte;
  720. {}
  721. begin
  722.    CursBot := vCursBot;
  723. end; {ScreenOBJ.CursBot}
  724.  
  725. procedure ScreenOBJ.CursHalf;
  726. {}
  727. var Charsize: byte;
  728. begin
  729.    CharSize := CharHeight;
  730.    CursSize(CharSize div 2, pred(CharSize));
  731. end; {ScreenOBJ.CursHalf}
  732.  
  733. procedure ScreenOBJ.CursFull;
  734. {}
  735. var Charsize: byte;
  736. begin
  737.    CharSize := CharHeight;
  738.    CursSize(0,CharSize);
  739. end; {ScreenOBJ.CursFull}
  740.  
  741. procedure ScreenOBJ.CursOn;
  742. {}
  743. var Charsize: byte;
  744. begin
  745.    CharSize := CharHeight;
  746.    CursSize(CharSize-3, CharSize-2);
  747. end; {ScreenOBJ.CursOn}
  748.  
  749. procedure ScreenOBJ.CursOff;
  750. {}
  751. begin
  752.    CursSize(0,0);
  753. end; {ScreenOBJ.CursOff}
  754. {||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  755. {     S C R E E N    S A V E    &    R E S T O R E     }
  756. {||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  757. procedure ScreenOBJ.Exists;
  758. {makes sure there is a screen on the heap}
  759. begin
  760.    if ScreenPtr = nil then
  761.       Error(2);
  762. end; {ScreenOBJ.Exists}
  763.  
  764. procedure ScreenOBJ.DesqViewTest;
  765. {}
  766. var Regs: Registers;
  767. begin
  768.    with Regs do
  769.    begin
  770.       AX := $2B01;
  771.       CX := $4445;
  772.       DX := $5351;
  773.       intr($21,Regs);
  774.       if Al <> $FF then {DesqView present}
  775.       begin
  776.          Ah := $FE;
  777.          Intr($10,Regs);
  778.          vScreenPtr := ptr(ES,DI);
  779.       end;
  780.    end;
  781. end; {ScreenOBJ.DesqViewTest}
  782.  
  783. procedure ScreenOBJ.Create(X,Y,Attr:byte);
  784. {}
  785. var MemoryNeeded: longint;
  786. begin
  787.    MemoryNeeded := X*Y*2;
  788.    If MaxAvail < MemoryNeeded then
  789.       Error(1)
  790.    else
  791.    begin
  792.       If (X = 0) and (Y = 0) then    {map to physical screen}
  793.       begin
  794.          vWidth := Monitor^.Width;
  795.          (*
  796.          vDepth := 50;              {set to max for extended line displays}
  797.          *)
  798.          vDepth := Monitor^.Depth;
  799.          vVisible := true;
  800.          vScreenPtr :=  ptr(Monitor^.vBaseOfScreen,0);
  801.          oWritePtr^.SetScreen(vScreenPtr,vWidth);
  802.          vOnScreen := true;
  803.          DesqViewTest;
  804.          CursSave;
  805.          ResetWindow;
  806.       end
  807.       else
  808.       begin
  809.          vWidth := X;
  810.          vDepth := Y;
  811.          GetMem(vScreenPtr,MemoryNeeded);
  812.          oWritePtr^.SetScreen(vScreenPtr,vWidth);
  813.          SetWindow(1,1,X,Y);
  814.          Clear(Attr,' ');
  815.          CursReset;
  816.       end;
  817.    end;
  818. end; {ScreenOBJ.Create}
  819.  
  820. procedure ScreenOBJ.MoveFromScreen(var Source, Dest; Length:word);
  821. {}
  822. begin
  823.    oWritePtr^.MoveFromScreen(Source,Dest,Length);
  824. end; {ScreenOBJ.MoveFromScreen}
  825.  
  826. procedure ScreenOBJ.MoveToScreen(var Source, Dest; Length:word);
  827. {}
  828. begin
  829.    oWritePtr^.MoveToScreen(Source,Dest,Length);
  830. end; {ScreenOBJ.MoveToScreen}
  831.  
  832. procedure ScreenOBJ.Save;
  833. {saves current screen to instance}
  834. var 
  835.   MemoryNeeded: longint;
  836.   MVisible: boolean;
  837.   WinCoords: tByteCoords;
  838. begin
  839.    If ScreenPtr <> nil then
  840.       Freemem(vScreenPtr,Width*Depth*2);
  841.    MemoryNeeded := Monitor^.Width*Monitor^.Depth*2;
  842.    If MaxAvail < MemoryNeeded then
  843.       Error(1)
  844.    else
  845.    begin
  846.       vWidth := Monitor^.Width;
  847.       vDepth := Monitor^.Depth;
  848.       GetMem(vScreenPtr,MemoryNeeded);
  849.       MVisible := Mouse.Visible;
  850.       if MVisible then
  851.          Mouse.Hide;
  852.       MoveFromScreen(Monitor^.BaseOfScreen^,ScreenPtr^,vWidth*vDepth);
  853.       CursSave;
  854.       oWritePtr^.SetScreen(vScreenPtr,vWidth);
  855.       Screen.WindowCoords(WinCoords);
  856.       with WinCoords do
  857.          SetWindow(X1,Y1,X2,Y2); 
  858.       if MVisible then
  859.          Mouse.Show;
  860.    end;
  861. end; {ScreenOBJ.Save}
  862.  
  863. function ScreenOBJ.Width: byte;
  864. {}
  865. begin
  866.    Width := vWidth;
  867. end; {ScreenOBJ.Width}
  868.  
  869. function ScreenOBJ.Depth: byte;
  870. {}
  871. begin
  872.    if vVisible then
  873.    begin
  874.       Depth := Monitor^.Depth
  875.    end
  876.    else
  877.       Depth := vDepth;
  878. end; {ScreenOBJ.Depth}
  879.  
  880. function ScreenOBJ.ScreenPtr: pointer;
  881. {}
  882. begin
  883.    ScreenPtr := vScreenPtr;
  884. end; {ScreenOBJ.ScrPtr}
  885.  
  886. procedure ScreenOBJ.Display;
  887. {}
  888. var 
  889.   Wid,Dep:byte;
  890.   MVisible:boolean;
  891.   WinCoords: tByteCoords;
  892. begin
  893. {$IFNDEF FINAL}
  894.    Exists;
  895. {$ENDIF}
  896.    MVisible := Mouse.Visible;
  897.    if MVisible then
  898.       Mouse.Hide;
  899.    if Width = Monitor^.Width then  {one big move}
  900.       MoveToScreen(ScreenPtr^,Monitor^.BaseOfScreen^, width*Monitor^.Depth)
  901.    else
  902.    begin
  903.       Wid := Monitor^.Width;
  904.       if Wid > vWidth then
  905.          Wid := vWidth;
  906.       Dep := Monitor^.Depth;
  907.       if Dep > vDepth then
  908.          Dep := vDepth;
  909.       PartDisplay(1,1,Wid,Dep,1,1);
  910.    end;
  911.    {now restore cursor details}
  912.    Screen.GotoXY(WhereX,WhereY);
  913.    Screen.CursSize(CursTop,CursBot);
  914.    WindowCoords(WinCoords);
  915.    with WinCoords do
  916.       Screen.SetWindow(X1,Y1,X2,Y2);
  917.    if MVisible then           (* Change to restore Mouse Details *)
  918.       Mouse.Show;
  919. end; {ScreenOBJ.Display}
  920.  
  921. procedure ScreenOBJ.PartDisplay(X1,Y1,X2,Y2,X,Y:byte);
  922. {}
  923. var
  924.    MonitorWidth,
  925.    ScreenWidth,
  926.    SectionWidth   : byte;
  927.    I              : integer;
  928.    VisibleAdr,
  929.    VirtualAdr     : word;
  930.    VisiblePtr,
  931.    VirtualPtr     : pointer;
  932.    MVisible:boolean;
  933. begin
  934.    if X2 > vWidth then
  935.       X2 := vWidth;
  936.    if Y2 > vDepth then
  937.       Y2 := vDepth;
  938.    SectionWidth := succ(X2- X1);
  939.    MonitorWidth := Monitor^.Width;
  940.    ScreenWidth  := Width;
  941.    VirtualPtr := ScreenPtr;
  942.    VisiblePtr := Monitor^.BaseOfScreen;
  943.    MVisible := Mouse.Visible;
  944.    if MVisible then
  945.       Mouse.Hide;
  946.    For I :=  Y1 to Y2 do
  947.    begin
  948.        VisibleAdr := pred(Y+I-Y1)*MonitorWidth*2 + pred(X)*2;
  949.        VirtualAdr := pred(I)*ScreenWidth*2 + Pred(X1)*2;
  950.        MoveToScreen(Mem[Seg(VirtualPtr^):ofs(VirtualPtr^)+VirtualAdr],
  951.                     Mem[Seg(VisiblePtr^):ofs(VisiblePtr^)+VisibleAdr],
  952.                     Sectionwidth);
  953.    end;
  954.    if MVisible then
  955.       Mouse.Show;
  956. end; {ScreenOBJ.PartDisplay}
  957.  
  958. procedure ScreenOBJ.PartSlideDisplay(X1,Y1,X2,Y2:byte;Way:tDirection);
  959. {}
  960. var
  961.    I : integer;
  962. begin
  963.    Case Way of
  964.    Up    : begin
  965.               for I := Y2 downto Y1 do
  966.               begin
  967.                   PartDisplay(X1,Y1,X2,Y1+Y2-I,X1,I);
  968.                   Delay(50);
  969.               end;
  970.            end;
  971.    Down  : begin
  972.               for I := Y1 to Y2 do
  973.               begin
  974.                   PartDisplay(X1,Y1+Y2 -I,X2,Y2,X1,Y1);
  975.                   Delay(50);  {savor the moment!}
  976.               end;
  977.            end;
  978.    Left  : begin
  979.               for I := X1 to X2 do
  980.               begin
  981.                   PartDisplay(X1,Y1,I,Y2,X1+X2-I,Y1);
  982.               end;
  983.            end;
  984.    Right : begin
  985.               for I := X2 downto X1 do
  986.               begin
  987.                   PartDisplay(I,Y1,X2,Y2,X1,Y1);
  988.               end;
  989.            end;
  990.    Vert:   for I := Y1 to Y1 + (Y2 - Y1) div 2 do
  991.            begin
  992.               PartDisplay(X1,I,X2,I,X1,I);
  993.               PartDisplay(X1,Y2+Y1-I,X2,Y2+Y1-I,X1,Y2+Y1-I);
  994.               Delay(50);
  995.            end;
  996.    Horiz:  for I := X1 to X1 + succ(X2 -X1) div 2 do
  997.            begin
  998.               PartDisplay(I,Y1,I,Y2,I,Y1);
  999.               PartDisplay((X2)+X1-I,Y1,(X2)+X1-I,Y2,(X2)+X1-I,Y1);
  1000.               Delay(10);
  1001.            end;
  1002.    end; {case}
  1003. end; {ScreenOBJ.PartSlideDisplay}
  1004.  
  1005. procedure ScreenOBJ.SlideDisplay(Way: tDirection);
  1006. {}
  1007. var
  1008.   WinCoords: tByteCoords;
  1009.   X,Y,Top,Bot : byte;
  1010. begin
  1011.    X := Monitor^.Width;
  1012.    if X > vWidth then
  1013.       X := vWidth;
  1014.    Y := Monitor^.Depth;
  1015.    if Y > vDepth then
  1016.       Y := vDepth;
  1017.    PartSlideDisplay(1,1,X,Y,Way);
  1018.    {now restore cursor details}
  1019.    X := WhereX;
  1020.    Y := WhereY;
  1021.    Top := CursTop;
  1022.    Bot := CursBot;
  1023.    Screen.GotoXY(X,Y);
  1024.    Screen.CursSize(Top,Bot);
  1025.    WindowCoords(WinCoords);
  1026.    with WinCoords do
  1027.       Screen.SetWindow(X1,Y1,X2,Y2);
  1028. end; {ScreenOBJ.SlideDisplay}
  1029.  
  1030. procedure ScreenOBJ.PartSave (X1,Y1,X2,Y2:byte; VAR Dest);
  1031. {transfers data from active virtual screen to Dest}
  1032. var
  1033.    I,wid : byte;
  1034.    ScreenAdr: integer;
  1035.    MVisible: boolean;
  1036. begin
  1037.    wid := succ(X2- X1);
  1038.    MVisible := Mouse.Visible;
  1039.    if MVisible then
  1040.       Mouse.Hide;
  1041.    For I :=  Y1 to Y2 do
  1042.    begin
  1043.       ScreenAdr := Pred(I)*160 + Pred(X1)*2;
  1044.       MoveFromScreen(Mem[seg(vScreenPtr^):ofs(vScreenPtr^)+ScreenAdr],
  1045.                      Mem[seg(Dest):ofs(dest)+(I-Y1)*wid*2],
  1046.                      wid);
  1047.    end;
  1048.    if MVisible then
  1049.       Mouse.Show;
  1050. end; {ScreenOBJ.PartSave}
  1051.  
  1052. procedure ScreenOBJ.PartRestore (X1,Y1,X2,Y2:byte; VAR Source);
  1053. {restores data from Source and transfers to active virtual screen
  1054.  - used internally}
  1055. var
  1056.    I,wid : byte;
  1057.    ScreenAdr: integer;
  1058.    MVisible: boolean;
  1059. begin
  1060.    wid := succ(X2- X1);
  1061.    MVisible := Mouse.Visible;
  1062.    if MVisible then
  1063.       Mouse.Hide;
  1064.    For I :=  Y1 to Y2 do
  1065.    begin
  1066.     ScreenAdr := Pred(I)*160 + Pred(X1)*2;
  1067.     MoveToScreen(Mem[Seg(Source):ofs(Source)+(I-Y1)*wid*2],
  1068.                  Mem[seg(vScreenPtr^):ofs(vScreenPtr^)+ScreenAdr],
  1069.                  wid);
  1070.    end;
  1071.    if MVisible then
  1072.      Mouse.Show;
  1073. end; {ScreenOBJ.PartRestore}
  1074.  
  1075. procedure ScreenOBJ.CopyScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  1076. {copies text and attributes from one part of screen to another}
  1077. Var
  1078.    S : word;
  1079.    SPtr : pointer;
  1080.    MVisible: boolean;
  1081. begin
  1082.     S := succ(Y2-Y1)*succ(X2-X1)*2;
  1083.     If Maxavail < S then
  1084.        Error(3)
  1085.     else
  1086.     begin
  1087.        MVisible := Mouse.Visible;
  1088.        if MVisible then
  1089.           Mouse.Hide;
  1090.        GetMem(SPtr,S);
  1091.        PartSave(X1,Y1,X2,Y2,SPtr^);
  1092.        PartRestore(X,Y,X+X2-X1,Y+Y2-Y1,SPtr^);
  1093.        FreeMem(Sptr,S);
  1094.        if MVisible then
  1095.           Mouse.Show;
  1096.     end;
  1097. end; {ScreenOBJ.CopyScreenBlock}
  1098.  
  1099. procedure ScreenOBJ.MoveScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  1100. {Moves text and attributes from one part of screen to another,
  1101.  replacing with Replace_Char}
  1102. const
  1103.   Replace_Char = ' ';
  1104. Var
  1105.    S : word;
  1106.    SPtr : pointer;
  1107.    I : Integer;
  1108.    ST : string;
  1109.    MVisible: boolean;
  1110. begin
  1111.     S := succ(Y2-Y1)*succ(X2-X1)*2;
  1112.     If Maxavail < S then
  1113.        Error(3)
  1114.     else
  1115.     begin
  1116.        MVisible := Mouse.Visible;
  1117.        if MVisible then
  1118.           Mouse.Hide; 
  1119.        GetMem(SPtr,S);
  1120.        PartSave(X1,Y1,X2,Y2,SPtr^);
  1121.        St := Replicate(succ(X2-X1),Replace_Char);
  1122.        For I := Y1 to Y2 do
  1123.            WritePlain(X1,I,St);
  1124.        PartRestore(X,Y,X+X2-X1,Y+Y2-Y1,SPtr^);
  1125.        FreeMem(Sptr,S);
  1126.        if MVisible then
  1127.           Mouse.Show;
  1128.     end;
  1129. end; {ScreenOBJ.MoveScreenBlock}
  1130.  
  1131. procedure ScreenOBJ.Scroll(Way:tDirection;X1,Y1,X2,Y2:byte);
  1132. {used for screen scrolling, uses Copy & Plainwrite for speed}
  1133. const
  1134.   Replace_Char = ' ';
  1135. var
  1136.   I : integer;
  1137. begin
  1138.     Case Way of
  1139.     Up   : begin
  1140.                CopyScreenBlock(X1,succ(Y1),X2,Y2,X1,Y1);
  1141.                WritePlain(X1,Y2,replicate(succ(X2-X1),Replace_Char));
  1142.            end;
  1143.     Down : begin
  1144.                CopyScreenBlock(X1,Y1,X2,pred(Y2),X1,succ(Y1));
  1145.                WritePlain(X1,Y1,replicate(succ(X2-X1),Replace_Char));
  1146.            end;
  1147.     Left : begin
  1148.                CopyScreenBlock(succ(X1),Y1,X2,Y2,X1,Y1);
  1149.                For I := Y1 to Y2 do
  1150.                    WritePlain(X2,I,Replace_Char);
  1151.            end;
  1152.     Right: begin
  1153.                CopyScreenBlock(X1,Y1,pred(X2),Y2,succ(X1),Y1);
  1154.                For I := Y1 to Y2 do
  1155.                    WritePlain(X1,I,Replace_Char);
  1156.            end;
  1157.     end; {case}
  1158. end; {ScreenOBJ.Scroll}
  1159. {||||||||||||||||||||||||||||||||||||}
  1160. {     S C R E E N    W R I T E S     }
  1161. {||||||||||||||||||||||||||||||||||||}
  1162. procedure ScreenOBJ.Write(Str:string);
  1163. {write at the cursor position using the default attributes, and
  1164.  moves cursor to end of string}
  1165. var 
  1166.    X,Y:byte;
  1167.    MVisible: boolean;
  1168. begin
  1169. {$IFNDEF FINAL}
  1170.    Exists;
  1171. {$ENDIF}
  1172.    MVisible := Mouse.Visible;
  1173.    X := WhereX + pred(oWritePtr^.WinX);
  1174.    Y := WhereY + pred(oWritePtr^.WinY);
  1175.    if MVisible and Mouse.InZone(X,Y,X+length(Str),Y) then
  1176.    begin
  1177.       Mouse.Hide;
  1178.       oWritePtr^.Write(Str);
  1179.       Mouse.Show;
  1180.    end
  1181.    else
  1182.       oWritePtr^.Write(Str);
  1183. end; {ScreenOBJ.Write}
  1184.  
  1185. procedure ScreenOBJ.WriteLn(Str:string);
  1186. {write at the cursor position using the default attributes, and
  1187.  moves cursor to next line}
  1188. var 
  1189.    X,Y:byte;
  1190.    MVisible: boolean;
  1191. begin
  1192. {$IFNDEF FINAL}
  1193.    Exists;
  1194. {$ENDIF}
  1195.    MVisible := Mouse.Visible;
  1196.    X := WhereX+ pred(oWritePtr^.WinX);
  1197.    Y := WhereY+ pred(oWritePtr^.WinY);
  1198.    if MVisible and Mouse.InZone(X,Y,X+length(Str),Y) then
  1199.    begin
  1200.       Mouse.Hide;
  1201.       oWritePtr^.WriteLn(Str);
  1202.       Mouse.Show;
  1203.    end
  1204.    else
  1205.       oWritePtr^.WriteLn(Str);
  1206. end; {ScreenOBJ.WriteLn}
  1207.  
  1208. procedure ScreenOBJ.WriteAT(X,Y,attr:byte;Str:string);
  1209. {}
  1210. var
  1211.    MVisible: boolean;
  1212.    GlobalX,GlobalY: byte;
  1213. begin
  1214. {$IFNDEF FINAL}                  
  1215.    Exists;                       
  1216. {$ENDIF}
  1217.    if Attr = 0 then
  1218.       WritePlain(X,Y,Str)
  1219.    else   
  1220.    begin
  1221.       MVisible := Mouse.Visible;
  1222.       GlobalX := X + pred(oWritePtr^.WinX);
  1223.       GlobalY := Y + pred(oWritePtr^.WinY);
  1224.       if MVisible and Mouse.InZone(GlobalX,GlobalY,GlobalX+length(Str),GlobalY) then
  1225.       begin
  1226.          Mouse.Hide;
  1227.          oWritePtr^.WriteAT(X,Y,attr,Str);
  1228.          Mouse.Show;
  1229.       end
  1230.       else
  1231.          oWritePtr^.WriteAT(X,Y,attr,Str);
  1232.    end;
  1233. end; {ScreenOBJ.WriteAT}
  1234.  
  1235. procedure ScreenOBJ.WriteHi(X,Y,AttrHi,Attr:byte;Str:string);
  1236. {}
  1237. var 
  1238.   P:byte;
  1239.   Hi : Boolean;
  1240.  
  1241.      procedure WriteBit(Str:string);
  1242.      begin
  1243.         if Hi then
  1244.            WriteAt(X,Y,AttrHi,Str)
  1245.         else
  1246.            WriteAt(X,Y,Attr,Str);
  1247.      end;
  1248.  
  1249. begin
  1250.    Hi := False;
  1251.    P := Pos(vHiMarker,Str);
  1252.    While P <> 0 do
  1253.    begin
  1254.        if P > 1 then
  1255.           WriteBit(copy(Str,1,pred(P)));
  1256.        Delete(Str,1,P);
  1257.        inc(X,pred(P));
  1258.        P := Pos(vHiMarker,Str);
  1259.        Hi := not Hi;
  1260.    end;
  1261.    WriteBit(Str);
  1262. end; {ScreenOBJ.WriteHi}
  1263.  
  1264. procedure ScreenOBJ.WritePlain(X,Y:byte;Str:string);
  1265. {}
  1266. var
  1267.    MVisible: boolean;
  1268.    GlobalX,GlobalY: byte;
  1269. begin
  1270. {$IFNDEF FINAL}
  1271.    Exists;
  1272. {$ENDIF}
  1273.    MVisible := Mouse.Visible;
  1274.    GlobalX := X + pred(oWritePtr^.WinX);
  1275.    GlobalY := Y + pred(oWritePtr^.WinY);
  1276.    if MVisible and Mouse.InZone(GlobalX,GlobalY,GlobalX+length(Str),GlobalY) then
  1277.    begin
  1278.       Mouse.Hide;
  1279.       oWritePtr^.WritePlain(X,Y,Str);
  1280.       Mouse.Show;
  1281.    end
  1282.    else
  1283.       oWritePtr^.WritePlain(X,Y,Str);
  1284. end; {ScreenOBJ.WritePlain}
  1285.  
  1286. procedure ScreenOBJ.WriteCap(X,Y,AttrCap,Attr:byte;Str:string);
  1287. {Writes a string with the first capital letter in a different color}
  1288. var
  1289.   CapPos : byte;
  1290. begin
  1291.    If Str <> '' then
  1292.    begin
  1293.       WriteAt(X,Y,Attr,Str);   {write whole string in default cols}
  1294.       CapPos := 1;
  1295.       While (CapPos <= length(Str))
  1296.       and   ((Str[CapPos] in [#65..#90]) = false) do
  1297.          inc(CapPos);
  1298.       If CapPos <= length(Str) then
  1299.          WriteAt(X + pred(CapPos),Y,AttrCap,Str[CapPos]);
  1300.    end;
  1301. end; {ScreenOBJ.WriteCap}
  1302.  
  1303. procedure ScreenOBJ.WriteClick(X,Y,attr:byte;Str:string);
  1304. {writes text to the screen with a click!}
  1305. var
  1306.   I : Integer;
  1307.   L : byte;
  1308. begin
  1309.    L := length(Str);
  1310.    If OnScreen then
  1311.       for I := L downto 1 do
  1312.       begin
  1313.          WriteAt(X,Y,Attr,copy(Str,I,succ(L-I)));
  1314.          sound(500);delay(20);nosound;delay(30);
  1315.       end
  1316.    else
  1317.       WriteAt(X,Y,attr,Str); {don't click if not visible}
  1318. end; {ScreenOBJ.WriteClick}
  1319.  
  1320. procedure ScreenOBJ.WriteCenter(Y,Attr:byte;Str:string);
  1321. {}
  1322. var 
  1323.   X1,Y1,X2,Y2: byte;
  1324.   X : integer; 
  1325. begin
  1326.    if oWritePtr^.WindowActive then
  1327.    begin
  1328.       oWritePtr^.GetWinCoords(X1,Y1,X2,Y2);
  1329.       X := (succ(X2-X1) - length(Str)) div 2;
  1330.    end
  1331.    else
  1332.       X :=  (Width - length(Str)) div 2;
  1333.    if X < 1 then
  1334.       X := 1;
  1335.    WriteAt(X,Y,attr,Str);
  1336. end; {ScreenOBJ.WriteCenter}
  1337.  
  1338. procedure ScreenOBJ.WriteBetween(X1,X2,Y,Attr:byte;Str:string);
  1339. {}
  1340. var X : integer;
  1341. begin
  1342.    if length(Str) >= X2 - X1 + 1 then
  1343.       WriteAt(X1,Y,attr,Str)
  1344.    else
  1345.    begin
  1346.        X := X1 + (X2 - X1 + 1 - length(Str)) div 2 ;
  1347.        WriteAt(X,Y,attr,Str);
  1348.    end;
  1349. end; {ScreenOBJ.WriteBetween}
  1350.  
  1351. procedure ScreenOBJ.WriteRight(X,Y,Attr:byte;Str:string);
  1352. {writes a right-justified string to the screen}
  1353. var X1 : integer;
  1354. begin
  1355.    X1 := succ(X-length(Str));
  1356.    if X1 < 1 then
  1357.       X1 := 1;
  1358.    WriteAT(X1,Y,attr,Str);
  1359. end; {ScreenOBJ.WriteRight}
  1360.  
  1361. procedure ScreenOBJ.WriteVert(X,Y,Attr:byte;Str:string);
  1362. {}
  1363. var
  1364.    L: byte;
  1365.    I: integer;
  1366. begin
  1367.    L := length(Str);
  1368.    If L > succ(Monitor^.Depth) - Y then
  1369.       L := succ(Monitor^.Depth) - Y;
  1370.    for I := 1 to L do
  1371.       WriteAt(X,Y-1+I,attr,Str[I]);
  1372. end; {ScreenOBJ.WriteVert}
  1373.  
  1374. procedure ScreenOBJ.Attrib(X1,Y1,X2,Y2,Attr:byte);
  1375. {changes color attrib at specified coords}
  1376. var
  1377.    I: integer;
  1378.    X: byte;
  1379.    MVisible: boolean;
  1380. begin
  1381. {$IFNDEF FINAL}
  1382.    Exists;
  1383. {$ENDIF}
  1384.    MVisible := Mouse.Visible;
  1385.    if MVisible then
  1386.       Mouse.Hide;
  1387.    X := Succ(X2-X1);
  1388.    for I := Y1 to Y2 do
  1389.       oWritePtr^.ChangeAttr(X1,I,Attr,X);
  1390.    if MVisible then
  1391.       Mouse.Show;
  1392. end; {ScreenOBJ.Attrib}
  1393.  
  1394. procedure ScreenOBJ.Clear(Att:byte;Ch:char);
  1395. {}
  1396. begin
  1397.     PartClear(1,1,Width,Depth,Att,Ch);
  1398. end; {ScreenOBJ.Clear}
  1399.  
  1400. procedure ScreenOBJ.PartClear(X1,Y1,X2,Y2,Att:byte;Ch:char);
  1401. {}
  1402. var
  1403.    I : integer;
  1404.    S : string;
  1405. begin
  1406.    Attrib(X1,Y1,X2,Y2,Att);
  1407.    S := Replicate(Succ(X2-X1),Ch);
  1408.    for I := Y1 to Y2 do
  1409.       WritePlain(X1,I,S);
  1410. end; {ScreenOBJ.PartClear}
  1411.  
  1412. procedure ScreenOBJ.ClearText(X1,Y1,X2,Y2:byte);
  1413. {}
  1414. var
  1415.    I : integer;
  1416.    S : string;
  1417. begin
  1418.    S := Replicate(Succ(X2-X1),' ');
  1419.    for I := Y1 to Y2 do
  1420.        WritePlain(X1,I,S);
  1421. end; {ScreenOBJ.ClearText}
  1422.  
  1423. procedure ScreenOBJ.ReadWord(X,Y:byte;var Attr:byte; var Ch : char);
  1424. {updates vars Attr and Ch with attribute and character bytes in screen
  1425.  location (X,Y) of the active screen}
  1426. Type
  1427.   ScreenWordRec = record
  1428.      Ch   : char;   
  1429.      Attr : byte;
  1430.   end;
  1431. var
  1432.    VisiblePtr: pointer;
  1433.    VisibleAdr : word;
  1434.    SW : ScreenWordRec;
  1435. begin
  1436.     X := X + pred(oWritePtr^.WinX);
  1437.     Y := Y + pred(oWritePtr^.WinY);
  1438.     VisiblePtr := Monitor^.BaseOfScreen;
  1439.     VisibleAdr := pred(Y)*Monitor^.Width*2 + pred(X)*2;
  1440.     MoveFromScreen(mem[Seg(VisiblePtr^):ofs(VisiblePtr^)+VisibleAdr],
  1441.                       mem[seg(SW):ofs(SW)],1);
  1442.     Attr := SW.Attr;
  1443.     Ch   := SW.Ch;
  1444. end; {ScreenOBJ.ReadWord}
  1445.  
  1446. function ScreenOBJ.ReadChar(X,Y:byte):char;
  1447. var
  1448.    A : byte;
  1449.    C : char;
  1450. begin
  1451.     ReadWord(X,Y,A,C);
  1452.     ReadChar := C;
  1453. end; {ScreenOBJ.ReadChar}
  1454.  
  1455. function ScreenOBJ.ReadAttr(X,Y:byte):byte;
  1456. var
  1457.    A : byte;
  1458.    C : char;
  1459. begin
  1460.    ReadWord(X,Y,A,C);
  1461.    ReadAttr := A;
  1462. end; {ScreenOBJ.ReadAttr}
  1463.  
  1464. function ScreenOBJ.ReadStr(X1,X2,Y:byte):string;
  1465. var
  1466.    I : integer;
  1467.    Str: string;
  1468. begin
  1469.     Str := '';
  1470.     for I := X1 to X2 do
  1471.         Str := Str + ReadChar(I,Y);
  1472.     ReadStr := Str;
  1473. end; {ScreenOBJ.ReadStr}
  1474.  
  1475. procedure ScreenOBJ.TitleEngine(X1,Y1,X2,Y2,LeftPad,RightPad,Battr,Tattr:byte; 
  1476.                                 Str, Title: string);
  1477. {}
  1478. var
  1479.    TitVert: byte; {0-top, 1-dropbox, 2-bottom}
  1480.    TitHoriz:byte; {0-left, 1-center, 2-right}
  1481.    MaxWidth:integer;
  1482.    X,Y : byte;
  1483. begin
  1484.    if (Title[2] in [TitPos[1],TitPos[2],TitPos[3]])
  1485.    and (Title[1] in [TitPos[4],TitPos[5],TitPos[6]]) then {swap 'em}
  1486.    begin
  1487.       insert(Title[2],Title,1);
  1488.       delete(Title,3,1);
  1489.    end;
  1490.    if Title[1] = TitPos[1] then
  1491.       TitHoriz := 0
  1492.    else if Title[1] = TitPos[3] then
  1493.       TitHoriz := 2
  1494.    else
  1495.       TitHoriz := 1;
  1496.    if Title[1] in [TitPos[1],TitPos[2],TitPos[3]] then
  1497.       delete(Title,1,1);
  1498.    if Title = '' then exit;
  1499.    if (Title[1] = TitPos[5]) and (Y2-Y1 > 1) then
  1500.       TitVert := 1
  1501.    else if Title[1] = TitPos[6] then
  1502.       TitVert := 2
  1503.    else
  1504.       TitVert := 0;
  1505.    if Title[1] in [TitPos[4],TitPos[5],TitPos[6]] then
  1506.       delete(Title,1,1);
  1507.    if Title = '' then exit;
  1508.    {check title is narrow enough to fit}
  1509.    if TitVert = 1 then 
  1510.       MaxWidth :=  pred(X2-X1)
  1511.    else
  1512.       MaxWidth := X2-X1-3;
  1513.    if TitVert = 0 then
  1514.       dec(MaxWidth,LeftPad+RightPad);
  1515.    if MaxWidth <= 0 then
  1516.       Title := ''
  1517.    else
  1518.       delete(Title,succ(MaxWidth),255);  {truncate title}
  1519.    Case Titvert of
  1520.       0: begin
  1521.          Case TitHoriz of
  1522.             0 : WriteAt(succ(X1)+LeftPad,Y1,Tattr,Title);
  1523.             1 : WriteBetween(succ(X1)+LeftPad,pred(X2)-RightPad,y1,Tattr,Title);
  1524.             else WriteRight(pred(X2)-RightPad,Y1,Tattr,Title);
  1525.          end; {case}
  1526.       end;
  1527.       1: begin
  1528.          WriteAt(X1,Y1+2,Battr,str[8]+
  1529.                             replicate(pred(X2-X1),str[2])+
  1530.                             Str[5]);
  1531.          Case TitHoriz of
  1532.             0 : WriteAt(succ(X1),succ(Y1),Tattr,Title);
  1533.             1 : WriteBetween(X1,X2,succ(y1),Tattr,Title);
  1534.             else WriteRight(pred(X2),succ(Y1),Tattr,Title);
  1535.          end; {case}
  1536.       end;
  1537.       2: begin
  1538.          Case TitHoriz of
  1539.             0 : WriteAt(succ(X1),Y2,Tattr,Title);
  1540.             1 : WriteBetween(X1,X2,Y2,Tattr,Title);
  1541.             else WriteRight(pred(X2),Y2,Tattr,Title);
  1542.          end; {case}
  1543.       end;
  1544.    end; {case}
  1545. end; {ScreenOBJ.TitleEngine}
  1546.  
  1547. procedure ScreenOBJ.BoxEngine(X1,Y1,X2,Y2,LeftPad,RightPad,Battr,Tattr,MAttr,style:byte;
  1548.                               Filled: boolean;
  1549.                               Title: string);
  1550. {Used internally by Box and FBox}
  1551. const
  1552.    Style1:string[10] = '┌─┐│┤┘└├│─';
  1553.    Style2:string[10] = '╔═╗║╣╝╚╠║═';
  1554.    Style3:string[10] = '╓─╖║╢╜╙╟║─';
  1555.    Style4:string[10] = '╒═╕│╡╛╘╞│═';
  1556.    Style5:string[10] = '┌─╖│╡╝╘╞║═';
  1557. var
  1558.    Line,
  1559.    FLine,
  1560.    Str: string;
  1561.    I: integer;
  1562. begin
  1563.    if Style = 6 then
  1564.    begin
  1565.       PartClear(X1,Y1,X2,Y2,Mattr,' ');
  1566.       WriteAT(X1,Y1,BAttr,replicate(X2-pred(X1),char(223)));
  1567.       WriteAT(X1,Y1+2,BAttr,replicate(X2-pred(X1),'_'));
  1568.       WriteBetween(X1,X2,succ(Y1),Tattr,Title);
  1569.    end
  1570.    else
  1571.    begin
  1572.       case Style of
  1573.       0 : Str := '          ';
  1574.       1 : Str := Style1;
  1575.       2 : Str := Style2;
  1576.       3 : Str := Style3;
  1577.       4 : Str := Style4;
  1578.       5 : Str := Style5;
  1579.       else Str := Replicate(10,chr(style));
  1580.       end;
  1581.       WriteAt(X1,Y1,Battr,Str[1]);
  1582.       Line := replicate(pred(X2-X1),Str[2]);
  1583.       WriteAt(X1+1,Y1,Battr,Line);
  1584.       WriteAt(X2,Y1,Battr,Str[3]);
  1585.       for I := Y1+1 to Y2-1 do
  1586.       begin
  1587.          WriteAt(X1,I,Battr,Str[4]);
  1588.          WriteAt(X2,I,Battr,Str[9]);
  1589.       end;
  1590.       if Filled then
  1591.          PartClear(succ(X1),succ(Y1),pred(X2),pred(Y2),MAttr,' ');
  1592.       WriteAt(X1,Y2,Battr,Str[7]);
  1593.       Line := replicate(pred(X2-X1),Str[10]);
  1594.       WriteAt(X1+1,Y2,Battr,Line);
  1595.       WriteAt(X2,Y2,Battr,Str[6]);
  1596.       {now the title: extract the first two character positions, and draw it}
  1597.       if Title <> '' then
  1598.          TitleEngine(X1,Y1,X2,Y2,LeftPad,RightPad,Battr,Tattr,Str,Title);
  1599.    end;
  1600. end; {BoxEngine}
  1601.  
  1602. procedure ScreenOBJ.Box(X1,Y1,X2,Y2,attr,style:byte);
  1603. {draws box and leaves internal area as is}
  1604. begin
  1605.     BoxEngine(X1,Y1,X2,Y2,0,0,attr,attr,attr,Style,false,'');
  1606. end; {ScreenOBJ.Box}
  1607.  
  1608. procedure ScreenOBJ.FillBox(X1,Y1,X2,Y2,attr,style:byte);
  1609. {draws box and erases internal area}
  1610. begin
  1611.    BoxEngine(X1,Y1,X2,Y2,0,0,attr,attr,attr,Style,true,'');
  1612. end; {ScreenOBJ.FillBox}
  1613.  
  1614. procedure ScreenOBJ.ShadFillBox(X1,Y1,X2,Y2,attr,style:byte);
  1615. {draws box and erases internal area}
  1616. begin
  1617.    BoxEngine(X1,Y1,X2,Y2,0,0,attr,attr,attr,Style,true,'');
  1618.    ShadowTOT^.DrawShadowXY(X1,Y1,X2,Y2);
  1619. end; {ScreenOBJ.ShadFillBox}
  1620.  
  1621. procedure ScreenOBJ.TitledBox(X1,Y1,X2,Y2,Battr,Tattr,MAttr,style:byte;Title:string);
  1622. {}
  1623. begin
  1624.    BoxEngine(X1,Y1,X2,Y2,0,0,Battr,Tattr,MAttr,Style,true,title);
  1625. end; {ScreenOBJ.TitledFillBox}
  1626.  
  1627. procedure ScreenOBJ.HorizLine(X1,X2,Y,Attr,Style : byte);
  1628. var
  1629.   I : integer;
  1630.   LineChar : char;
  1631. begin
  1632.    case Style of
  1633.    0   : LineChar := ' ';
  1634.    2,4 : LineChar := '═';
  1635.    1,3 : LineChar := '─';
  1636.    else LineChar := Chr(Style);
  1637.    end; {case}
  1638.    WriteAt(X1,Y,Attr,replicate(X2-X1+1,LineChar))
  1639. end;   {ScreenOBJ.HorizLine}
  1640.  
  1641. procedure ScreenOBJ.VertLine(X,Y1,Y2,Attr,Style:byte);
  1642. {}
  1643. var
  1644.     I : integer;
  1645.     LineChar : char;
  1646. begin
  1647.    case Style of
  1648.    0   : LineChar := ' ';
  1649.    2,4 : LineChar := '║';
  1650.    1,3 : LineChar := '│';
  1651.    else LineChar := Chr(Style);
  1652.    end; {case}
  1653.    for I := Y1 to Y2 do
  1654.       WriteAt(X,I,Attr,LineChar)
  1655. end; {ScreenOBJ.VertLine}
  1656.  
  1657. procedure ScreenOBJ.SmartVertLine(X,Y1,Y2,Attr,Style:byte);
  1658. {draws box character and adjust any lines it overlays}
  1659. var
  1660.     I : integer;
  1661.     LineStr : string[19];
  1662.     TestCh,
  1663.     Ch : char;
  1664.     StringOffset : byte;
  1665.  
  1666.     function AdjacentChar(X,Y:byte): char;
  1667.     {}
  1668.     begin
  1669.        if (X < 1) or (X > width) then
  1670.           AdjacentChar := ' '
  1671.        else
  1672.           AdjacentChar := ReadChar(X,Y);
  1673.     end; {AdjacentChar}
  1674.  
  1675.     function LineCh(X,Y:byte): char;
  1676.     {}
  1677.     const
  1678.        LeftSingle: string[13] = '─┬┐┼┤┴┘╥╖╫╢╨╜';       
  1679.        LeftDouble: string[13] = '═╦╗╬╣╩╝╤╕╪╡╧╛';
  1680.        RightSingle:string[13] = '┌─┬├┼└┴╓╥╟╫╙╨';
  1681.        RightDouble:string[13] = '╔═╦╠╬╚╩╒╤╞╪╘╧';
  1682.     var
  1683.       LineStyle : char;
  1684.     begin
  1685.        LineStyle := AdjacentChar(pred(X),Y);
  1686.        if pos(LineStyle,RightSingle) > 0 then
  1687.           LineStyle := '─'
  1688.        else if pos(LineStyle,RightDouble) > 0 then
  1689.           LineStyle := '═'
  1690.        else
  1691.           LineStyle := ' ';
  1692.        case LineStyle of
  1693.        '─': if pos(AdjacentChar(succ(X),Y),leftSingle) > 0 then
  1694.                Ch := LineStr[2+StringOffset]
  1695.             else
  1696.                Ch := LineStr[3+StringOffset];
  1697.        '═': if pos(AdjacentChar(succ(X),Y),LeftDouble) > 0 then
  1698.                Ch := LineStr[4+StringOffset]
  1699.             else
  1700.                Ch := LineStr[5+StringOffset];
  1701.        else  TestCh := AdjacentChar(succ(X),Y);
  1702.              If pos(TestCh,LeftSingle) > 0 then
  1703.                 Ch := LineStr[6+StringOffset]
  1704.              else if pos(TestCh,LeftDouble) > 0  then
  1705.                 Ch := LineStr[7+StringOffset]
  1706.              else
  1707.                 Ch := LineStr[1];
  1708.        end; {case}
  1709.        LineCh := Ch;
  1710.     end; {LineCh}
  1711.  
  1712. begin
  1713.    if Style in [2,4] then
  1714.       LineStr := '║╥╖╦╗╓╔╫╢╬╣╟╠╨╜╩╝╙╚'
  1715.    else
  1716.       LineStr := '│┬┐╤╕┌╒┼┤╪╡├╞┴┘╧╛└╘';
  1717.    {draw first character}
  1718.    StringOffSet := 0;
  1719.    WriteAt(X,Y1,attr,LineCh(X,Y1));
  1720.    StringOffSet := 6;
  1721.    for I := succ(Y1) to pred(Y2) do
  1722.       WriteAt(X,I,attr,LineCh(X,I));
  1723.    StringOffSet := 12;
  1724.    WriteAt(X,Y2,attr,LineCh(X,Y2));
  1725. end; {ScreenOBJ.SmartVertLine}
  1726.  
  1727. procedure ScreenOBJ.SmartHorizLine(X1,X2,Y,Attr,Style:byte);
  1728. {draws box character and adjust any lines it overlays}
  1729. var
  1730.     I : integer;
  1731.     LineStr : string[19];
  1732.     TestCh,
  1733.     Ch : char;
  1734.     StringOffset : byte;
  1735.  
  1736.     function AdjacentChar(X,Y:byte): char;
  1737.     {}
  1738.     begin
  1739.        if (Y < 1) or (Y > depth) then
  1740.           AdjacentChar := ' '
  1741.        else
  1742.           AdjacentChar := ReadChar(X,Y);
  1743.     end; {AdjacentChar}
  1744.  
  1745.     function LineCh(X,Y:byte): char;
  1746.     {}
  1747.     const
  1748.         DownSingle: string[13] = '┌┬┐│├┼┤╒╤╕╞╪╡';
  1749.  
  1750.         DownDouble: string[13] = '╔╦╗║╠╬╣╓╥╖╟╫╢';
  1751.  
  1752.         UpSingle:   string[13] = '│├┼┤└┴┘╞╪╡╘╧╛';
  1753.  
  1754.         UpDouble:   string[13] = '║╠╬╣╚╩╝╟╫╢╙╨║';
  1755.     var
  1756.       LineStyle : char;
  1757.     begin
  1758.        LineStyle := AdjacentChar(X,pred(Y));
  1759.        If pos(LineStyle,DownSingle) > 0 then
  1760.           LineStyle := '│'
  1761.        else if pos(LineStyle,DownDouble) > 0 then
  1762.           LineStyle := '║'
  1763.        else                    
  1764.           LineStyle := ' ';
  1765.        case LineStyle of
  1766.        '│': if pos(AdjacentChar(X,succ(Y)),UpSingle) > 0 then
  1767.                Ch := LineStr[2+StringOffset]
  1768.             else
  1769.                Ch := LineStr[3+StringOffset];
  1770.        '║': if pos(AdjacentChar(X,succ(Y)),UpDouble) > 0 then
  1771.                Ch := LineStr[4+StringOffset]
  1772.             else
  1773.                Ch := LineStr[5+StringOffset];
  1774.        else  TestCh := AdjacentChar(X,succ(Y));
  1775.              If pos(TestCh,UpSingle) > 0 then
  1776.                 Ch := LineStr[6+StringOffset]
  1777.              else if pos(TestCh,UpDouble) > 0 then
  1778.                 Ch := LineStr[7+StringOffset]
  1779.              else
  1780.                 Ch := LineStr[1];
  1781.        end; {case}
  1782.        LineCh := Ch;
  1783.     end; {LineCh}
  1784.  
  1785. begin
  1786.    if Style in [2,4] then
  1787.       LineStr := '═╞╘╠╚╒╔╪╧╬╩╤╦╡╛╣╝╕╗ '
  1788.    else
  1789.       LineStr := '─├└╟╙┌╓┼┴╫╨┬╥┤┘╢╜┐╖';
  1790.    {draw first character}
  1791.    StringOffSet := 0;
  1792.    WriteAt(X1,Y,attr,LineCh(X1,Y));
  1793.    StringOffSet := 6;
  1794.    for I := succ(X1) to pred(X2) do
  1795.       WriteAt(I,Y,attr,LineCh(I,Y));
  1796.    StringOffSet := 12;
  1797.    WriteAt(X2,Y,attr,LineCh(X2,Y));
  1798. end; {ScreenOBJ.SmartHorizLine}
  1799.  
  1800. procedure ScreenOBJ.WriteHScrollBar(X1,X2,Y,Attr: byte; Current,Max: longint);
  1801. {}
  1802. var 
  1803.   X,LineLength : integer;
  1804. begin
  1805.    WriteAT(X1,Y,Attr,ScrollTOT^.LeftChar);
  1806.    WriteAT(X2,Y,Attr,ScrollTOT^.RightChar);
  1807.    WriteAT(succ(X1),Y,Attr,replicate(pred(X2-X1),ScrollTOT^.BackgroundChar));
  1808.    if (Current > 0) and (Max >= Current) then
  1809.    begin
  1810.      LineLength := X2 - succ(X1);
  1811.      if LineLength > 0 then
  1812.      begin
  1813.         X := (Current * LineLength) div Max;
  1814.         if Current >= Max then
  1815.            X := pred(LineLength);
  1816.         if (X < 0) or (Current = 1) then
  1817.            X := 0;
  1818.         WriteAT(succ(X1) + X,Y,Attr,ScrollTOT^.ElevatorChar);
  1819.      end;
  1820.    end;
  1821. end; {ScreenOBJ.WriteHScrollBar}
  1822.  
  1823. procedure ScreenOBJ.WriteVScrollBar(X,Y1,Y2,Attr: byte; Current,Max: longint);
  1824. {}
  1825. var 
  1826.   BC : char;
  1827.   I,Y,LineLength : integer;
  1828. begin
  1829.    WriteAT(X,Y1,Attr,ScrollTOT^.UpChar);
  1830.    WriteAT(X,Y2,Attr,ScrollTOT^.DownChar);
  1831.    BC := ScrollTOT^.BackgroundChar;
  1832.    for I := succ(Y1) to pred(Y2) do
  1833.        WriteAT(X,I,Attr,BC);
  1834.    if (Current > 0) and (Max >= Current) then
  1835.    begin
  1836.      LineLength := Y2 - succ(Y1);
  1837.      if LineLength > 0 then
  1838.      begin
  1839.         Y := (Current * LineLength) div Max;
  1840.         if Current >= Max then
  1841.            Y := pred(LineLength);
  1842.         if (Y < 0) or (Current = 1) then
  1843.            Y := 0;
  1844.         WriteAT(X,succ(Y1)+Y,Attr,ScrollTOT^.ElevatorChar);
  1845.      end;
  1846.    end;
  1847. end; {ScreenOBJ.WriteVScrollBar}
  1848.  
  1849. destructor ScreenOBJ.Done;
  1850. {}
  1851. var MemoryUsed: longint;
  1852. begin
  1853.    If not OnScreen then
  1854.    begin
  1855.       MemoryUsed := Width*Depth*2;
  1856.       freemem(vScreenPtr,MemoryUsed);
  1857.       dispose(oWritePtr,Done);
  1858.    end;
  1859. end;  {ScreenOBJ.Done}
  1860. {|||||||||||||||||||||||||||||||||||||||||||}
  1861. {                                           }
  1862. {     S c r o l l O B J   M E T H O D S     }
  1863. {                                           }
  1864. {|||||||||||||||||||||||||||||||||||||||||||}
  1865. constructor ScrollOBJ.Init;
  1866. {}
  1867. begin
  1868.    SetDefaults;
  1869. end; {ScrollOBJ.Init}
  1870.  
  1871. procedure ScrollOBJ.SetDefaults;
  1872. {}
  1873. begin
  1874.    SetScrollChars('','',char(27),char(26),'','░');
  1875. end;  {of ScrollOBJ.SetDefaults}
  1876.  
  1877. procedure ScrollOBJ.SetScrollChars(U,D,L,R,E,B:char);
  1878. {}
  1879.  
  1880. begin
  1881.    vUpArrowChar := U;
  1882.    vDownArrowChar := D; 
  1883.    vLeftArrowChar := L; 
  1884.    vRightArrowChar := R;
  1885.    vElevatorChar := E;
  1886.    vBackgroundChar := B;
  1887. end;  {of ScrollOBJ.SetScrollChars}
  1888.  
  1889. function ScrollOBJ.UpChar:char;
  1890. {}
  1891. begin
  1892.    UpChar := vUpArrowChar;
  1893. end; {ScrollOBJ.UpChar}
  1894.  
  1895. function ScrollOBJ.DownChar:char;
  1896. {}
  1897. begin
  1898.    DownChar := vDownArrowChar;
  1899. end; {ScrollOBJ.DownChar}
  1900.  
  1901. function ScrollOBJ.LeftChar:char;
  1902. {}
  1903. begin
  1904.    LeftChar := vLeftArrowChar;
  1905. end; {ScrollOBJ.LeftChar}
  1906.  
  1907. function ScrollOBJ.RightChar:char;
  1908. {}
  1909. begin
  1910.    RightChar := vRightArrowChar;
  1911. end; {ScrollOBJ.RightChar}
  1912.  
  1913. function ScrollOBJ.ElevatorChar:char;
  1914. {}
  1915. begin
  1916.    ElevatorChar := vElevatorChar;
  1917. end; {ScrollOBJ.ElevatorChar}
  1918.  
  1919. function ScrollOBJ.BackgroundChar:char;
  1920. {}
  1921. begin
  1922.    BackgroundChar := vBackgroundChar;
  1923. end; {ScrollOBJ.BackgroundChar}
  1924.  
  1925. destructor ScrollOBJ.Done;
  1926. begin end;
  1927. {|||||||||||||||||||||||||||||||||||||||||||}
  1928. {                                           }
  1929. {     S h a d o w O B J   M E T H O D S     }
  1930. {                                           }
  1931. {|||||||||||||||||||||||||||||||||||||||||||}
  1932. constructor ShadowOBJ.Init;
  1933. {}
  1934. begin
  1935.    SetDefaults;
  1936. end; {ShadowOBJ.Init}
  1937.  
  1938. procedure ShadowOBJ.SetDefaults;
  1939. {}
  1940. begin
  1941.    vShadWidth := 2;
  1942.    vShadDepth := 1;
  1943.    vShadPos := DownRight;
  1944.    vShadAttr := 7;
  1945.    vShadChar := ' ';
  1946. end; {ShadowOBJ.SetDefaults}
  1947.  
  1948. procedure ShadowOBJ.DrawShadow(Border:tCoords);
  1949. {}
  1950. var
  1951.   Outer: tCoords;
  1952.  
  1953.   procedure DrawPartofShadow(X1,Y1,X2,Y2:byte);
  1954.   begin
  1955.      if (X1 > X2) or (Y1 > Y2) then exit;
  1956.      if vShadChar = ' ' then {attribute change}
  1957.         Screen.Attrib(X1,Y1,X2,Y2,vShadAttr)
  1958.      else
  1959.         Screen.PartClear(X1,Y1,X2,Y2,vShadAttr,vShadChar);
  1960.   end; {of sub proc DrawPartofShadow}
  1961.  
  1962. begin
  1963.    OuterCoords(Border,Outer);
  1964.    case vShadPos of
  1965.    UpLeft:   begin
  1966.                 DrawPartofShadow(Outer.X1,Outer.Y1,pred(Border.X1),Border.Y2-vShadDepth);
  1967.                 DrawPartofShadow(Border.X1,Outer.Y1,Border.X2-vShadWidth,pred(Border.Y1));
  1968.              end;
  1969.    UpRight:  begin
  1970.                 DrawPartofShadow(Border.X1+vShadWidth,Outer.Y1,Outer.X2,pred(Border.Y1));
  1971.                 DrawPartofShadow(succ(Border.X2),Border.Y1,Outer.X2,Border.Y2-vShadDepth);
  1972.              end;
  1973.    DownLeft: begin
  1974.                 DrawPartofShadow(Outer.X1,Border.Y1+vShadDepth,pred(Border.X1),Outer.Y2);
  1975.                 DrawPartofShadow(Border.X1,succ(Border.Y2),Border.X2-vShadWidth,Outer.Y2);
  1976.              end;
  1977.    DownRight:begin
  1978.                 DrawPartofShadow(Border.X1+vShadWidth,succ(Border.Y2),Outer.X2,Outer.Y2);
  1979.                 DrawPartofShadow(succ(Border.X2),Border.Y1+vShadDepth,Outer.X2,Border.Y2);
  1980.              end;
  1981.    end; {case}
  1982. end; {ShadowOBJ.DrawShadow}
  1983.  
  1984. procedure ShadowOBJ.DrawShadowXY(X1,Y1,X2,Y2:integer);
  1985. {}
  1986. var
  1987.   Border: tCoords;
  1988. begin
  1989.    Border.X1 := X1;
  1990.    Border.Y1 := Y1;
  1991.    Border.X2 := X2;
  1992.    Border.Y2 := Y2;
  1993.    DrawShadow(Border);
  1994. end; {ShadowOBJ.DrawShadowXY}
  1995.  
  1996. procedure ShadowOBJ.SetShadowStyle(ShadP:ShadowPosition; ShadA:byte; ShadC:char);
  1997. {}
  1998. begin
  1999.    vShadPos  :=  ShadP;
  2000.    vShadAttr :=  ShadA;
  2001.    vShadChar :=  ShadC;
  2002. end; {ShadowOBJ.SetShadowStyle}
  2003.  
  2004. procedure ShadowOBJ.SetShadowSize(ShadW,ShadD:byte);
  2005. {}
  2006. begin
  2007.    vShadWidth := ShadW;
  2008.    vShadDepth := ShadD;
  2009. end; {ShadowOBJ.SetShadowSize}
  2010.  
  2011. function ShadowOBJ.ShadWidth: byte;
  2012. {}
  2013. begin
  2014.    ShadWidth := vShadWidth;
  2015. end; {ShadowOBJ.ShadWidth}
  2016.  
  2017. function ShadowOBJ.ShadDepth: byte;
  2018. {}
  2019. begin
  2020.    ShadDepth := vShadDepth;
  2021. end; {ShadowOBJ.ShadDepth}
  2022.  
  2023. function ShadowOBJ.ShadAttr: byte;
  2024. {}
  2025. begin
  2026.    ShadAttr := vShadAttr;
  2027. end; {ShadowOBJ.ShadAttr}
  2028.  
  2029. function ShadowOBJ.ShadChar: char;
  2030. {}
  2031. begin
  2032.    ShadChar := vShadChar;
  2033. end; {ShadowOBJ.ShadChar}
  2034.  
  2035. function ShadowOBJ.ShadPos: ShadowPosition;
  2036. {}
  2037. begin
  2038.    ShadPos := vShadPos;
  2039. end; {ShadowOBJ.ShadPos}
  2040.  
  2041. procedure ShadowOBJ.OuterCoords(Border:tCoords;var Outer:tCoords);
  2042. {}
  2043. begin
  2044.    Case vShadPos of
  2045.    UpLeft:   begin
  2046.                 Outer.X1 := Border.X1-vShadWidth;
  2047.                 Outer.Y1 := Border.Y1-vShadDepth;
  2048.                 Outer.X2 := Border.X2;
  2049.                 Outer.Y2 := Border.Y2;
  2050.              end;
  2051.    UpRight:  begin
  2052.                 Outer.X1 := Border.X1;
  2053.                 Outer.Y1 := Border.Y1-vShadDepth;
  2054.                 Outer.X2 := Border.X2+vShadWidth;
  2055.                 Outer.Y2 := Border.Y2;
  2056.              end;
  2057.    DownLeft: begin
  2058.                 Outer.X1 := Border.X1-vShadWidth;
  2059.                 Outer.Y1 := Border.Y1;
  2060.                 Outer.X2 := Border.X2;
  2061.                 Outer.Y2 := Border.Y2+vShadDepth;
  2062.              end;
  2063.    DownRight:begin
  2064.                 Outer.X1 := Border.X1;
  2065.                 Outer.Y1 := Border.Y1;
  2066.                 Outer.X2 := Border.X2+vShadWidth;
  2067.                 Outer.Y2 := Border.Y2+vShadDepth;
  2068.              end;
  2069.    end; {case}
  2070.    if Outer.X1 < 1 then Outer.X1 := 1;
  2071.    if Outer.Y1 < 1 then Outer.Y1 := 1;
  2072.    if Outer.X2 > Screen.Width then Outer.X2 := Screen.Width;
  2073.    if Outer.Y2 > Screen.Depth then Outer.Y2 := Screen.Depth;
  2074. end; {ShadowOBJ.OuterCoords}
  2075.  
  2076. procedure ShadowOBJ.OuterXY(var X1,Y1,X2,Y2: integer);
  2077. {}
  2078. var Temp1,Temp2:tCoords;
  2079. begin
  2080.    Temp1.X1 := X1;
  2081.    Temp1.Y1 := Y1;
  2082.    Temp1.X2 := X2;
  2083.    Temp1.Y2 := Y2;
  2084.    OuterCoords(Temp1,Temp2);
  2085.    X1 := Temp2.X1;
  2086.    Y1 := Temp2.Y1;
  2087.    X2 := Temp2.X2;
  2088.    Y2 := Temp2.Y2;
  2089. end; {ShadowOBJ.OuterXY}
  2090.  
  2091. destructor ShadowOBJ.Done;
  2092. begin end;
  2093.  
  2094. {|||||||||||||||||||||||||||||||||||||||||||||||}
  2095. {                                               }
  2096. {     U N I T   I N I T I A L I Z A T I O N     }
  2097. {                                               }
  2098. {|||||||||||||||||||||||||||||||||||||||||||||||}
  2099.  
  2100. procedure FastInit;
  2101. {initilizes objects and global variables}
  2102. begin
  2103.     Screen.Init;
  2104.     Screen.Create(0,0,0);
  2105.     new(ScrollTOT,Init);
  2106.     new(ShadowTOT,Init);
  2107. end; {FastInit}
  2108.  
  2109. {end of unit - add intialization routines below}
  2110. {$IFNDEF OVERLAY}
  2111. begin
  2112.    FastInit;
  2113. {$ENDIF}
  2114. end.
  2115.  
  2116.